Pascal Super Library/Pascal Super Library (CW International)(1997).bin/DELPHI32/GRAPHICS/TS32/SPRITE.PAS

Pascal/Delphi Source File | 1996-03-14 | 13KB | 432 lines

unit Sprite;

(*********************************************
TSprite->TObject

The base class for all sprites.  Descendants of
this class are managed by the TDIBDrawingSurface
sprite engine.

Properties

BoundingRect-
  The rectangle that bounds the sprite.  Determined based on
  the sprite's Width and Height and Margin properties.
Dead-
  The sprite engine sets this to TRUE to flag that the sprite
  should be removed from the list.
Destination-
  The sprite's logical destination.
DIBDrawingSurface-
  Returns the TDIBDrawingSurface that this sprite is
  registered with.  This is set by a TSpriteEngine that the
  sprite is added to.
Dirty-
  Flags whether this sprite needs to be redrawn when the
  dirty rectangle system is employed.  Used by the sprite
  engine.
DirtyRect-
  Returns the sprite's dirty rectangle ... a union of its
  current and previous positions.  Used by the sprite
  engine.
Height-
  The height of the sprite, in pixels.  Descendant classes
  MUST assign a value to this property.
MarginLeft, MarginRight, MarginTop, MarginBottom-
  Decreases the bounding rectangle for this sprite for collision
  detection purposes.
MotionType-
  Controls whether the sprite continues in a straight line after
  it reaches its destination or whether it stops.
Moved-
  Flags whether the sprite moved during the last cycle.  Used
  by the sprite engine.
PhysicalPosition-
  The physical position of the sprite in the DIBDrawingSurface,
  after taking Offset values into account.
Position-
  The logical position of the sprite in the DIBDrawingSurface
  coordinates.
Priority-
  The ZOrder of the sprite.  Sprites with a lower value will
  appear on top.  Use the ChangeSpritePriority method of
  TSpriteEngine to change a sprite's priority, instead of changing
  this property directly.
Speed-
  The speed of the sprite.  The lower the number, the faster
  the sprite.
Tag-
  Store misc values here.
Visible-
  Controls whether the sprite will be rendered by the engine.
Width-
  The width of the sprite, in pixels.  Descendant classes
  MUST assign a value to this property.

Events

Methods

FudgedDistance-
  Returns the absoulte difference in logical coords between
  this and another sprite.  More economical than calling the
  standard distance formula, but not as accurate.  Can be
  useful for collision detection.
Move-
  You can override this procedure to augment or replace
  the default sprite movement routines.
RefreshBackground-
  This method is called by the sprite engine and is part
  of the dirty rectangle system.
Render-
  This method MUST be overriden to provide an implementation
  for the sprite's rendering on the DIBDrawingSurface.
*********************************************)

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, DIBDrawingSurface,
  Utility;

type

  TMotionType = ( mtStopAtDest, mtContinuous );

  TSprite = class( TObject )
  private
     FMoved: boolean;
     nCycle: word;
     nDX, nDY: integer;
     nIncX, nIncY: integer;
     nError: integer;
     nInc: byte;
     FPri: integer;
     FMotion: TMotionType;
     FVisible: boolean;
     FDirty: boolean;
     FSetMoved: boolean;
     FWidth: integer;
     FHeight: integer;
     FWidth2: integer;
     FHeight2: integer;
     FTag: integer;
     bKill: boolean;
     FMarginLeft, FMarginRight, FMarginTop, FMarginBottom: integer;
  protected
     dds: TDIBDrawingSurface;
     ptDestination: TPoint;
     nSpeed: byte;
     ptLastPosition: TPoint;    { Used to refresh the background in dirty rectangle system }
     ptLastDrawn: TPoint;       { The last position the sprite was drawn }
     ptPosition: TPoint;        { Current logical position }
     ptPhysical: TPoint;        { Logical location - offsets }
     function GetBoundingRect: TRect;
     function GetDirtyRect: TRect;
     procedure SetDestination( const pt: TPoint );
     procedure SetSpeed( const n: byte );
     procedure SetWidth( n: integer );
     procedure SetHeight( n: integer );
     procedure SetDead( b: boolean );
  public
     engine: TComponent;        { The sprite engine that this sprite is registered with }
     constructor Create;
     function FudgedDistance( s: TSprite ): word;
     procedure Move; dynamic;
     procedure PreMove; dynamic;
     procedure PostMove; dynamic;
     procedure RefreshBackground; dynamic;
     procedure Render; dynamic;
     property BoundingRect: TRect read GetBoundingRect;
     property Destination: TPoint read ptDestination write SetDestination;
     property Dead: boolean read bKill write SetDead;
     property DIBDrawingSurface: TDIBDrawingSurface read dds write dds;
     property Dirty: boolean read FDirty write FDirty;
     property DirtyRect: TRect read GetDirtyRect;
     property Height: integer read FHeight write SetHeight;
     property MarginLeft: integer read FMarginLeft write FMarginLeft;
     property MarginRight: integer read FMarginRight write FMarginRight;
     property MarginTop: integer read FMarginTop write FMarginTop;
     property MarginBottom: integer read FMarginBottom write FMarginBottom;
     property MotionType: TMotionType read FMotion write FMotion;
     property Moved: boolean read FMoved write FSetMoved;
     property PhysicalPosition: TPoint read ptPhysical;
     property Position: TPoint read ptPosition write ptPosition;
     property Priority: integer read FPri write FPri;
     property Speed: byte read nSpeed write SetSpeed;
     property Tag: integer read FTag write FTag;
     property Visible: boolean read FVisible write FVisible default TRUE;
     property Width: integer read FWidth write SetWidth;
  end;

implementation

uses
  SpriteEngine;

constructor TSprite.Create;
begin
  dds := nil;
  Priority := 1;
  ptPosition := Point( 0, 0 );
  SetSpeed( 20 );
  SetDestination( Point( 0, 0 ) );
  MotionType := mtStopAtDest;
  FVisible := TRUE;
end;

procedure TSprite.PreMove;
begin
  FDirty := FALSE;

{ Handle wrapping if it's enabled }
  if dds.WrapHorizontal then
     begin
        if ptPosition.X < 0 then
           ptPosition.X := dds.PhysicalWidth;
        if ptPosition.X > dds.PhysicalWidth then
           ptPosition.X := 0;
     end;
  if dds.WrapVertical then
     begin
        if ptPosition.Y < 0 then
           ptPosition.Y := dds.PhysicalHeight;
        if ptPosition.Y > dds.PhysicalHeight then
           ptPosition.Y := 0;
     end;

{ Adjust physical position based on offset into logical space }
  ptPhysical := ptPosition;
  Dec( ptPhysical.X, dds.OffsetX );
  Dec( ptPhysical.Y, dds.OffsetY );
end;

(***************************************************
The default Move method will move the sprite toward
it's destination at a constant speed.
***************************************************)
procedure TSprite.Move;
var
  bMoveX, bMoveY: boolean;
begin

  bMoveX := TRUE;
  bMoveY := TRUE;

{ Check to see if sprite has reached its destination }
  if FMotion = mtStopAtDest then
     begin
        if nIncX > 0 then
           begin
              if ptPosition.X >= ptDestination.X then
                 bMoveX := FALSE;
           end
        else
           begin
              if ptPosition.X <= ptDestination.X then
                 bMoveX := FALSE;
           end;
        if nIncY > 0 then
           begin
              if ptPosition.Y >= ptDestination.Y then
                 bMoveY := FALSE;
           end
        else
           begin
              if ptPosition.Y <= ptDestination.Y then
                 bMoveY := FALSE;
           end;
     end;

  if bMoveX or bMoveY then
     begin
        Inc( nCycle );
        if nCycle >= nSpeed then
           begin
              nCycle := 0;
              if nDX > nDY then
                 begin
                    Inc( nError, nDY );
                    if nError > nDX then
                       begin
                          Dec( nError, nDX );
                          if bMoveY then
                             Inc( ptPosition.Y, nIncY );
                       end;
                    if bMoveX then
                       Inc( ptPosition.X, nIncX );
                 end
              else
                 begin
                    Inc( nError, nDX );
                    if nError > 0 then
                       begin
                          Dec( nError, nDY );
                          if bMoveX then
                             Inc( ptPosition.X, nIncX );
                       end;
                    if bMoveY then
                       Inc( ptPosition.Y, nIncY );
                 end;
           end;
     end
  else
     ptPosition := ptDestination;

end;

procedure TSprite.PostMove;
begin
  FMoved := not EqualPt( ptPosition, ptLastDrawn ) or FSetMoved;
  ptLastPosition := ptPosition;
  FSetMoved := FALSE;
end;

(***************************************************
Determine the sprite's speed vector's when its
destination changes.
***************************************************)
procedure TSprite.SetDestination( const pt: TPoint );
begin
  nError := 0;
  ptDestination := pt;
  nDX := ptDestination.X - ptPosition.X;
  nDY := ptDestination.Y - ptPosition.Y;
  if nDX >= 0 then
     nIncX := nInc
  else
     begin
        nIncX := -nInc;
        nDX := -nDX;
     end;
  if nDY >= 0 then
     nIncY := nInc
  else
     begin
        nIncY := -nInc;
        nDY := -nDY;
     end;
end;

(***************************************************
The speed will determine how many pixels per turn the
sprite moves, or how many cycles of delay are introduced
between movement.
***************************************************)
procedure TSprite.SetSpeed( const n: byte );
begin
  nSpeed := 0;
  if n <= 10 then
     nInc := 11 - n
  else
     begin
        nInc := 1;
        nSpeed := n - 11;
     end;
  SetDestination( ptDestination );
end;

(*********************************************
Determine a "fudged" distance by simply adding
the absolute values of the positions.  Faster
than executing the correct distance formula.
*********************************************)
function TSprite.FudgedDistance( s: TSprite ): word;
begin
  Result := Abs( ptPosition.X - s.ptPosition.X ) + Abs( ptPosition.Y - s.ptPosition.Y );
end;

procedure TSprite.Render;
begin
  ptLastDrawn := ptPhysical;
end;

(***************************************************
Returns the union of the sprite's current rectangle
and the rectangle of its last position.  Used by the
sprite engine when dirty rectangle processing is on.
***************************************************)
function TSprite.GetDirtyRect: TRect;
var
  rectOld, rectNew, rectUnion: TRect;
begin
  rectOld := Rect( ptLastDrawn.X - FWidth2,
     ptLastDrawn.Y - FHeight2,
     ptLastDrawn.X + FWidth2,
     ptLastDrawn.Y + FHeight2 );

  rectNew := Rect( ptPhysical.X - FWidth2,
     ptPhysical.Y - FHeight2,
     ptPhysical.X + FWidth2,
     ptPhysical.Y + FHeight2 );

  UnionRect( rectUnion, rectOld, rectNew );
  Result := rectUnion;
end;

(***************************************************
Restores the area of the sprite's last position.
Called by the sprite engine.
***************************************************)
procedure TSprite.RefreshBackground;
var
  rectDest: TRect;
begin
  if Visible then
     begin
        rectDest := Rect( ptLastDrawn.X - FWidth2,
           ptLastDrawn.Y - FHeight2,
           ptLastDrawn.X + FWidth2 - 1,
           ptLastDrawn.Y + FHeight2 - 1 );
        if Assigned( dds.BackgroundDIB ) then
           dds.DIBCanvas.CopyRect( rectDest, dds.BackgroundDIB.DIBCanvas, rectDest )
        else
           begin
              dds.DIBCanvas.BrushColorIndex := dds.AutoBlankColor;
              dds.DIBCanvas.FillRect( rectDest );
           end;
     end;
end;

(***************************************************
The sprite's width and height (as well as half of the
sprite's width and height) are stored.
***************************************************)
procedure TSprite.SetWidth( n: integer );
begin
  FWidth := n;
  FWidth2 := n div 2;
end;

procedure TSprite.SetHeight( n: integer );
begin
  FHeight := n;
  FHeight2 := n div 2;
end;

(***************************************************
Return the sprite's bounding rect for collision
detection.  Here the sprite's four margins are taken
into account, as well as size.
***************************************************)
function TSprite.GetBoundingRect: TRect;
begin
  Result := Rect( ptPhysical.X - FWidth2 + FMarginLeft,
     ptPhysical.Y - FHeight2 + FMarginTop,
     ptPhysical.X + FWidth2 + 1 - FMarginRight,
     ptPhysical.Y + FHeight2 + 1 - FMarginBottom );
end;

procedure TSprite.SetDead( b: boolean );
begin
  if b <> bKill then
     begin
        bKill := b;
        if b then
           if engine <> nil then
              TSpriteEngine( engine ).RemoveSprite( self );
     end;
end;

end.